home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / comm.swg / 0049_Great Fossil Code.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  12.8 KB  |  387 lines
  1.  
  2. Unit Fossil;
  3.  
  4. Interface
  5.  
  6. Uses Dos;
  7.  
  8. Type
  9.    DriverInfo      = Record
  10.    StrucSize       : Word;
  11.    MajorVersion    : Byte;
  12.    CurrentRevision : Byte;
  13.    IDPtr           : Array[1..2] of Word;
  14.    InputBufferSize : Word;
  15.    InputBufferFree : Word;
  16.    OutputBufferSize: Word;
  17.    OutputBufferFree: Word;
  18.    ScreenWidth     : Byte;
  19.    ScreenHieght    : Byte;
  20.    BaudRate        : Byte;
  21.    DriverName      : String[80];
  22.                      End;
  23.    MaxStr = String[255];
  24.    Str80  = String[80];
  25.  
  26. Var
  27.     Regs            : Registers;
  28.     FossilInfo      : DriverInfo;
  29.  
  30. Function Port_Status(Port:Byte):Word;
  31. Procedure Set_Baud( Port:Byte; Speed:Byte);
  32. Function Xmit(Port:Byte; OutChar:Char):Word;
  33. Function CommWrite(Port:Byte; OutString:MaxStr):Word;
  34. Function CommRead(Port:Byte):Char;
  35. Function Init_Fossil(Port:Byte; BreakAddr:Word; Var MaxFunctionNum:Byte;
  36.                      Var RevDoc:Byte):Word;
  37. Procedure DeInit_Fossil(Port:Byte);
  38. Procedure ModemDTR(Port:Byte; DTRUp:Boolean);
  39. Procedure Get_Timer_Data(Var InterruptNum:Byte;  (* Return Timing Info *)
  40.                          Var  TicksPerSec:Byte;
  41.                          Var MillisecsPer:Word);
  42. Procedure Flush_Output_Buffer(Port:Byte);
  43. Procedure Purge_Output_Buffer(Port:Byte);
  44. Procedure Purge_Input_Buffer(Port:Byte);
  45. Function Xmit_Nowait(Port:Byte; OutChar:Char):Boolean;
  46. Function Read_Ahead(Port:Byte):Char;
  47. Function KeyRead_Nowait:Word;
  48. Function Keyread:Word;
  49. Procedure Flow_Control(Port:Byte; ControlMask:Byte);
  50. Function Abort_Control(Port:Byte; Flags:Byte):Word;
  51. Procedure Set_CursorXY(X,Y:Byte);
  52. Procedure Get_CursorLoc(Var X,Y:Byte);
  53. Procedure ANSI_Write(OutChar:Char);
  54. Procedure Watchdog(Port:Byte; CarrierWatch:Boolean);
  55. Procedure BIOS_Write(OutChar:Char);
  56. Function TimerChain(Add:Boolean; FunctionSeg:Word; FunctionOfs:Word):Boolean;
  57. Procedure System_Reboot(ColdBoot:Boolean);
  58. Function ReadBlock(Port:Byte; MaxBytes:Word; Var Buffer):Word;
  59. Function WriteBlock(Port:Byte; MaxBytes:Word; Var Buffer):Word;
  60. Procedure SendBreak(Port:Byte; SendOn:Boolean);
  61. Procedure Driver_Info(Port:Byte; Var FossilInfo:DriverInfo);
  62. Function Install_Application(CodeNum:Byte; EntrySeg:Word; EntryOfs:Word):Boolean;
  63. Function Remove_Application(CodeNum:Byte; EntrySeg:Word; EntryOfs:Word):Boolean;
  64.  
  65. implementation
  66.  
  67. Function Port_Status;
  68. Begin
  69. Regs.AH := $03;
  70. Regs.DX := Port;
  71. Intr($14,Regs);
  72. Port_Status := Regs.AX;
  73. End;
  74.  
  75. Procedure Set_Baud;                (* Speed  2 = 300   Baud   *)
  76.                                    (*        3 = 600   Baud   *)
  77. Begin                              (*        4 = 1200  Baud   *)
  78.     Regs.AL := (Speed SHL 5) + 3;  (*        5 = 2400  Baud   *)
  79.     Regs.DX := Port;               (*        6 = 4800  Baud   *)
  80.     Intr($14,Regs);                (*        7 = 9600  Baud   *)
  81.                                    (*        0 = 19200 Baud   *)
  82. End;                               (*        1 = 38400 Baud   *)
  83.  
  84. Function Xmit;
  85. Begin                            (* Send One character to the Port *)
  86.     Regs.AH := $01;
  87.     Regs.DX := Port;
  88.     Regs.AL := Ord(OutChar);
  89.     Intr($14,Regs);
  90.     Xmit := Regs.AX;
  91. End;
  92.  
  93. Function CommWrite;
  94. Var
  95.    I     : Byte;         (* Uninterruptable string to the port         *)
  96.    Len   : Byte;         (* If you're not going to look for keystrokes *)
  97.    Stat  : Byte;         (* piling up in the buffer.  This is a quick  *)
  98.    Error : Byte;         (* way to send a whole string to the port     *)
  99.  
  100. Begin
  101.     Len  := Length(OutString);
  102.     Stat := 128;
  103.     I    := 1;
  104.     While (I < Len) and ((Stat AND 128) = 128) Do
  105.         Begin
  106.         Regs.AH := $01;
  107.         Regs.AL := Ord(OutString[I]);
  108.         Regs.DX := Port;
  109.         Intr($14,Regs);
  110.         Stat := Regs.AL;
  111.         Inc(I);
  112.         End;
  113. CommWrite := Port_Status(Port);
  114. End;
  115.  
  116. Function CommRead;                      (* Read one character waiting at *)
  117. Begin                                   (* the comm port                 *)
  118. Regs.AH := $02;
  119. Regs.DX := Port;
  120. Intr($14,Regs);
  121. CommRead := Chr(Regs.AL);
  122. End;
  123.  
  124. Function Init_Fossil;                      (* Initialize the fossil driver *)
  125.                                            (* Raise DTR and prepare out/in *)
  126.                                            (* buffers for communications   *)
  127. Begin
  128. Regs.AH := $04;
  129. Regs.DX := Port;
  130. If BreakAddr > 0 Then
  131.    Begin
  132.    Regs.BX := $4F50;
  133.    Regs.CX := BreakAddr;
  134.    End;
  135. Intr($14,Regs);
  136. MaxFunctionNum := Regs.BL;
  137. RevDoc := Regs.BH;
  138. Init_Fossil := Regs.AX;
  139. End;
  140.  
  141. Procedure DeInit_Fossil;                       (* Tell Fossil that comm *)
  142. Begin                                          (* Operations are ended  *)
  143. Regs.AH := $05;
  144. Regs.DX := Port;
  145. Intr($14,Regs);
  146. End;
  147.  
  148. Procedure ModemDTR;               (* RAISE/Lower Modem DTR   *)
  149. Begin                             (* DTRUp = True  DTR is UP *)
  150. Regs.AH := $06;
  151. Regs.DX := Port;
  152. If DTRUp Then Regs.AL := 1
  153.          Else Regs.AL := 0;
  154. Intr($14,Regs);
  155. End;
  156.  
  157. Procedure Get_Timer_Data;         (* Return Timing Info *)
  158. Begin
  159. Regs.AH := $07;
  160. Intr($14,Regs);
  161. InterruptNum := Regs.AL;
  162. TicksPerSec := Regs.AH;
  163. MillisecsPer := Regs.DX;
  164. End;
  165.  
  166. Procedure Flush_Output_Buffer;      (* Send any remaining Data *)
  167. Begin
  168. Regs.AH := $08;
  169. Regs.DX := Port;
  170. Intr($14,Regs);
  171. End;
  172.  
  173. Procedure Purge_Output_Buffer;      (* Discard Data In Buffer *)
  174. Begin
  175. Regs.AH := $09;
  176. Regs.DX := Port;
  177. Intr($14,Regs);
  178. End;
  179.  
  180. Procedure Purge_Input_Buffer;
  181. Begin                                (* Discard all pending Input *)
  182. Regs.AH := $0A;
  183. Regs.DX := Port;
  184. Intr($14,Regs);
  185. End;
  186.  
  187. Function Xmit_Nowait;
  188. Begin                                      (* Send character Unbuffered to  *)
  189. Regs.AH := $0B;                            (* port.  Returns true if op was *)
  190. Regs.DX := Port;                           (* successful (there was room in *)
  191. Regs.AL := Ord(OutChar);                   (* the output buffer)            *)
  192. Intr($14,Regs);
  193. If Regs.AX = 1 Then Xmit_NoWait := True
  194.                Else Xmit_NoWait := False;
  195. End;
  196.  
  197. Function Read_Ahead;                    (* See what character is waiting *)
  198. Begin                                   (* in the buffer without reading *)
  199. Regs.AH := $0C;                         (* it out.  * PEEK *             *)
  200. Regs.DX := Port;
  201. Intr($14,Regs);
  202. Read_Ahead := Chr(Regs.AX);
  203. End;
  204.  
  205. Function KeyRead_Nowait;                 (* Does not wait for keypressed *)
  206. Begin                                    (* Returns $FFFF if no key is   *)
  207. Regs.AH := $0D;                          (* waiting.  Acts as "standard" *)
  208. Intr($14,Regs);                          (* keyscan-- ScanCode in high   *)
  209. Keyread_Nowait := Regs.AX;               (* order byte -- character in   *)
  210. End;                                     (* low byte                     *)
  211.  
  212. Function Keyread;                        (* As above but waits for key *)
  213. Begin
  214. Regs.AH := $0E;
  215. Intr($14,Regs);
  216. KeyRead := Regs.AX;
  217. End;
  218.  
  219. Procedure Flow_Control;
  220. Begin                                  (* Enable/Disable Flow Control      *)
  221. Regs.AH := $0F;                        (* ControlMask Values               *)
  222. Regs.DX := Port;                       (* 0 = Disable                      *)
  223. Regs.AL := (ControlMask AND 15) + $F0; (* Bit 0 Set = Enable XON/XOFF Recv *)
  224. Intr($14,Regs);                        (* Bit 1 Set = CTS/RTS              *)
  225. End;                                   (* Bit 2  is reserved for DSR/DTR   *)
  226.                                        (* Bit 3 Set = Enable XON/XOFF Send *)
  227.  
  228. Function Abort_Control;
  229. Begin                                  (* Not Well documented.             *)
  230. Regs.AH := $10;                        (* Flags = 1 Toggle ^C ^K chek      *)
  231. Regs.DX := Port;                       (* Flags = 2 Toggle Transmit ON/OFF *)
  232. Regs.AL := Flags;                      (* Huh?  I guess ON/OFF is stoping  *)
  233. Intr($14,Regs);                        (* data flow.  The present flag val *)
  234. Abort_Control := Regs.AX;              (* is stored and returned on the    *)
  235. End;                                   (* next call to this function       *)
  236.  
  237. Procedure Set_CursorXY;                (* Set Cursor Location               *)
  238. Begin                                  (* X,Y is 0 relative  X=Col Y=Row    *)
  239. Regs.AH := $11;                        (* I'm not sure if it just sets the  *)
  240. Regs.DH := Y;                          (* cursor on the screen or produces  *)
  241. Regs.DL := X;                          (* ANSI codes to do it on the remote *)
  242. Intr($14,Regs);                        (* I assume since there is no port   *)
  243. End;                                   (* that it is just the local term    *)
  244.  
  245. Procedure Get_CursorLoc;               (* Zero Relative as above            *)
  246. Begin
  247. Regs.AH := $12;
  248. Intr($14,Regs);
  249. Y:= Regs.DH;
  250. X:= Regs.DL;
  251. End;
  252.  
  253. Procedure ANSI_Write;                  (* Character to Screen Routed thru    *)
  254. Begin                                  (* ANSI.SYS                           *)
  255. Regs.AH := $13;
  256. Regs.AL := Ord(OutChar);
  257. Intr($14,Regs);
  258. End;
  259.  
  260. Procedure Watchdog;
  261. Begin                                  (* CarrierWatch = True Reboot on     *)
  262. Regs.AH := $14;                        (* Carrier Loss.                     *)
  263. Regs.DX := Port;
  264. If CarrierWatch Then Regs.AL := 1
  265.                 Else Regs.AL := 0;
  266. Intr($14,Regs);
  267. End;
  268.  
  269. Procedure BIOS_Write;                  (* BIOS write to the screen         *)
  270. Begin
  271. Regs.AH := $15;
  272. Regs.AL := Ord(OutChar);
  273. Intr($14,Regs);
  274. End;
  275.  
  276. Function TimerChain;                    (* Add/Delete function from timer  *)
  277.                                         (* Chain.  Creates or deletes from *)
  278.                                         (* dynamic list of function addr's *)
  279. Begin                                   (* to be exec'd during timer proc  *)
  280. Regs.AH := $16;
  281. Regs.ES := FunctionSeg;
  282. Regs.DX := FunctionOfs;
  283. If Add Then Regs.AL := 1
  284.        Else Regs.AL := 0;
  285. Intr($14,Regs);
  286. If Regs.AX = $FFFF Then TimerChain := False
  287.                    Else TimerChain := True;
  288. End;
  289.  
  290. Procedure System_Reboot;                   (* Reboot System,               *)
  291. Begin                                      (* ColdBoot = True = Hard Reset *)
  292. Regs.AH := $17;                            (* Coldboot = False = BootStrap *)
  293. If Coldboot Then Regs.AL := 0
  294.             Else Regs.AL := 1;
  295. Intr($14,regs);
  296. End;
  297.  
  298. Function ReadBlock;                   (* Reads Communications Buffer       *)
  299.                                       (* Into the Untyped Array Buffer     *)
  300.                                       (* Maxbytes is the size of the array *)
  301.                                       (* Returns the number of Bytes       *)
  302.                                       (* Actually Sent                     *)
  303. Begin
  304. Regs.AH := $18;
  305. Regs.DX := Port;
  306. Regs.CX := MaxBytes;
  307. Regs.ES := OFS(Buffer);
  308. Regs.DI := Seg(Buffer);
  309. Intr($14,Regs);
  310. ReadBlock := Regs.AX;
  311. End;
  312.  
  313. Function WriteBlock;                  (* Writes To Communications buffer   *)
  314.                                       (* From the Untyped Array Buffer.    *)
  315.                                       (* Maxbytes is the size of the array *)
  316. Var                                   (* Returns the number of Bytes       *)
  317.    BufferAddr : Byte Absolute Buffer; (* Actually Sent                     *)
  318.  
  319. Begin
  320. Regs.AH := $19;
  321. Regs.DX := Port;
  322. Regs.CX := MaxBytes;
  323. Regs.ES := OFS(BufferAddr);
  324. Regs.DI := Seg(BufferAddr);
  325. Intr($14,Regs);
  326. WriteBlock := Regs.AX;
  327. End;
  328.  
  329. Procedure SendBreak;                             (* Send Break to Port til *)
  330. Begin                                            (* Called With SendON = F *)
  331. Regs.AH := $1A;
  332. Regs.DX := Port;
  333. If SendOn Then Regs.AL := 1
  334.           Else Regs.AL := 0;
  335. Intr($14,Regs);
  336. End;
  337.  
  338. Procedure Driver_Info;
  339. Var
  340.    Temp     : String[80];            (* Return Driver Information in record *)
  341.    Segment  : Word;                  (* Structure Type of DriverInfo        *)
  342.    OffSet   : Word;
  343.    InputChr : Char;
  344.  
  345. Begin
  346. Regs.AH := $1B;
  347. Regs.DX := Port;
  348. Regs.ES := Seg(FossilInfo);
  349. Regs.DI := Ofs(FossilInfo);
  350. Regs.CX := SizeOf(FossilInfo);
  351. Intr($14,Regs);
  352. Segment := FossilInfo.IdPtr[2];
  353. OffSet  := FossilInfo.IdPtr[1];
  354. Temp := '';
  355. InputChr := ' ';
  356. While Ord(InputChr) <> 0 Do
  357.     Begin
  358.     InputChr := Chr(Mem[Segment:OffSet]);
  359.     Inc(OffSet);
  360.     Temp := Temp + InputChr;
  361.     End;
  362. FossilInfo.DriverName := Temp;
  363. End;
  364.  
  365. Function Install_Application;
  366. Begin
  367. Regs.AH := $7E;
  368. Regs.AL := CodeNum;
  369. Regs.DX := EntryOfs;
  370. Regs.DS := EntrySeg;
  371. Intr($14,Regs);
  372. If (Regs.AX = $1954) and (Regs.BH = 1) Then Install_Application := True
  373.                                        Else Install_Application := False;
  374. End;
  375.  
  376. Function Remove_Application;
  377. Begin
  378. Regs.AH := $7F;
  379. Regs.AL := Codenum;
  380. Regs.DX := EntryOfs;
  381. Regs.DS := EntrySeg;
  382. Intr($14,Regs);
  383. If (Regs.AX = $1954) and (Regs.BH = 1) Then Remove_Application := True
  384.                                        Else Remove_Application := False;
  385. End;
  386. End.
  387.